home *** CD-ROM | disk | FTP | other *** search
Wrap
10 'PC\PAD: an MS-BASIC editor/spreadsheet/printing routine; 4/07/83 20 SCREEN 0,0,0:WIDTH 80:CLS:KEY OFF:LOCATE 5,1:Q$=SPACE$(20) 30 PRINT Q$;" PC\PAD (ver. 1.3)" 40 PRINT Q$;"an editor/spreadsheet/printing program" 50 PRINT: PRINT 60 PRINT Q$;" If you are using this program" 70 PRINT Q$;" and find it of value," 80 PRINT Q$;" a $20 contribution is suggested." 90 PRINT 100 PRINT Q$;" (c) 1983" 110 PRINT Q$;" P. Fraundorf" 120 PRINT Q$;" P.O. Box 11394" 130 PRINT Q$;" St. Louis MO 63105" 140 PRINT 150 PRINT Q$;" You are encouraged to copy and" 160 PRINT Q$;" share this program with others." 170 LOCATE 24,1: PRINT "any key to continue..."; 180 Q$=INKEY$: IF Q$="" THEN 180 190 DEFINT I-N: LMX=400: HCW=8: CC$="\" 'set max lines,col width, & cc$ 200 DIM A$(LMX+1),M$(50),CSUM(16),RSUM(25): IMX=LMX-22: JMX=IMX-20 210 LCW=2*HCW: LCM=LCW-1: DEF FNV(I,J)=VAL(MID$(A$(I),LCW*J+1,LCW)) 220 DEF SEG=0: IF (PEEK(1040) AND 48)=48 THEN LD=13 ELSE LD=7 'mono/color 230 '-----------------------initialize function keys-------------------- 240 KEY ON 250 KEY 1,CC$+"view "+CHR$(13) 'relist 260 KEY 2,CC$+"compute"+CHR$(13) 'update computed entries 270 KEY 3,CC$+"up "+CHR$(13) 'look up 280 KEY 4,CC$+"down "+CHR$(13) 'look down 290 KEY 5,CC$+"left "+CHR$(13) 'look left 300 KEY 6,CC$+"right "+CHR$(13) 'look right 310 KEY 7,CC$+"yank "+CHR$(13) 'yank line to memory 320 KEY 8,CC$+"put "+CHR$(13) 'put line in text 330 KEY 9,CC$+"justify"+CHR$(13) 'right justify line 340 KEY 10,CC$+"save "+CHR$(13) 'save + offer restart 350 '---------------------------open source file----------------------- 360 FOR I=0 TO LMX: A$(I)="": NEXT: CLS: ON ERROR GOTO 5000 370 PRINT "disk files:": FILES: PRINT 380 INPUT "disk file name (rtn=none)";F$ 390 IF F$<>"" THEN GOSUB 1260 ELSE NLINE=0 400 '------------------------set up editing session-------------------- 410 INPUT "working file name (rtn=disk file name)";G$ 420 IF G$="" THEN G$=F$ 'if no working name, use disk file name 430 IF G$="" THEN END 'if still no working name, then exit program 440 IP=1: JP=0: IX=1: JY=1 'zero pointers 450 '-------------------------primary operating loop-------------------- 460 J0=JP: J1=JP+22: GOSUB 890: LOCATE JY,1 'list lines jp,jp+22 470 COLOR 13,0: LINE INPUT "",X$ 'give control to BASIC screen editor 480 COLOR 10,0: JY=CSRLIN-1 490 XX=INSTR(X$,CC$): IF XX=0 THEN 770 'store new line 500 '-----------------------menu of command primitives------------------ 510 Y$=MID$(X$,XX+1,1) 520 IF Y$="v" THEN 460 'view window 530 IF Y$="c" THEN 9990 'update computed entries 540 IF Y$="u" THEN IF JP>0 THEN JP=JP-1:GOTO 460 ELSE 460 'up 1 550 IF Y$="d" THEN IF JP<IMX THEN JP=JP+1:GOTO 460 ELSE 460 'down 1 560 IF Y$="l" THEN IF IP>HCW THEN IP=IP-HCW:GOTO 460 ELSE 460 'left 1 570 IF Y$="r" THEN IF IP<178-HCW THEN IP=IP+HCW:GOTO 460 ELSE 460 'right 1 580 IF Y$="y" THEN GOSUB 1382:GOTO 460 'yank line to memory 590 IF Y$="p" THEN GOSUB 1420:GOTO 460 'put line in text 600 IF Y$="j" THEN GOSUB 2060: GOTO 460 'justify line 610 IF Y$="s" THEN GOSUB 1340: GOTO 460 'save working file 620 IF Y$=CC$ THEN Y$=MID$(X$,XX+2,1) ELSE 770 630 '-------------------------- 2-key functions ---------------------- 640 IF Y$="v" THEN GOSUB 980: GOTO 460 'help file 650 IF Y$="c" THEN GOSUB 1190: GOTO 460 'reset filenames 660 IF Y$="u" THEN IF JP>19 THEN JP=JP-20:GOTO 460 ELSE JP=0 :GOTO 460 670 IF Y$="d" THEN IF JP<JMX THEN JP=JP+20:GOTO 460 ELSE JP=IMX:GOTO 460 680 IF Y$="l" THEN IF IP>64 THEN IP=IP-64:GOTO 460 ELSE IP=1 :GOTO 460 690 IF Y$="r" THEN IF IP<113 THEN IP=IP+64:GOTO 460 ELSE IP=177:GOTO 460 700 IF Y$="y" THEN GOSUB 1382:GOSUB 1410:GOTO 460 'remove line 710 IF Y$="p" THEN 1450 'goto insert loop 720 IF Y$="j" THEN GOSUB 2010: GOTO 460 'reset linewidth 730 IF Y$="s" THEN GOSUB 1570: GOTO 460 'print file 740 IF Y$="q" THEN GOTO 360 'quit/new file prompt 750 '-----------------------store previous screen line------------------ 760 'it would be nice to use L$=X$, but alas X$ reflects complex i/o logic 770 L$="": II=0 780 JX=JP+JY-1: Y$=A$(JX): LA=LEN(Y$): IF LA>IP+79 THEN II=1 790 FOR I=79 TO 1 STEP -1 800 X$=CHR$(SCREEN(JY,I)) 810 IF II=1 THEN L$=X$+L$ ELSE IF X$<>" " THEN II=1: GOTO 810 820 NEXT 830 LX=IP-1: LL=LEN(L$): IF JX+1>NLINE THEN NLINE=JX+1 840 IF LX>LA THEN A$(JX)=A$(JX)+STRING$(LX-LA," ")+L$: GOTO 870 850 IF LX>LA-79 THEN A$(JX)=LEFT$(A$(JX),LX)+L$: GOTO 870 860 A$(JX)=LEFT$(A$(JX),LX)+L$+STRING$(79-LL," ")+RIGHT$(A$(JX),LA-LX-79) 870 IF JY<23 THEN 470 ELSE IF JP<IMX THEN JP=JP+1:GOTO 460 ELSE 460 880 '-----------------------print lines from j0 to j1------------------- 890 CLS: LOCATE 24,1 900 COLOR 0,7:PRINT "^ ";G$;":";TAB(17);"^line";J0;"-";J1;TAB(33);"^col.";IP\LCW;"-";(IP+78)\LCW;TAB(49);"^for HELP:\[F1] ^keylist below:"; 910 LOCATE 1,1,1,LD-1,LD 920 COLOR 6,0 930 FOR I=J0 TO J1 940 PRINT MID$(A$(I),IP,79) 950 NEXT 960 RETURN 970 '============================print help file=========================== 980 CLS:Q$=SPACE$(6):LOCATE 4,1 990 PRINT Q$;" *** available functions ***": PRINT 1000 PRINT Q$;"[F1] view file window \[F1] print help file" 1010 PRINT Q$;" -------------spreadsheet computation key--------------" 1020 PRINT Q$;"[F2] update computations \[F2] reset filenames" 1030 PRINT Q$;" -----------------window movement keys-----------------" 1040 PRINT Q$;"[F3] move up 1 line \[F3] move up 20 lines" 1050 PRINT Q$;"[F4] move down 1 line \[F4] move down 20 lines" 1060 PRINT Q$;"[F5] move left 1/2 column \[F5] move left 4 columns" 1070 PRINT Q$;"[F6] move right 1/2 column \[F6] move right 4 columns" 1080 PRINT Q$;" -----------------text processing keys-----------------" 1090 PRINT Q$;"[F7] yank line into memory \[F7] yank and delete line" 1100 PRINT Q$;"[F8] put yanked line in text \[F8] sequential line insert" 1110 PRINT Q$;"[F9] right justify line \[F9] reset j-options" 1120 PRINT Q$;" -------------------file output key--------------------" 1130 PRINT Q$;"[F10] save file to disk \[F10] print file":PRINT 1140 PRINT Q$;" \\q quit file 1150 LOCATE 24,1: PRINT "except for F# keys, any key to continue..."; 1160 Q$=INKEY$: IF Q$="" THEN 1160 1170 RETURN 1180 '============================reset filenames========================== 1190 CLS 1200 PRINT "working filename (rtn=";G$;:INPUT")";X$:IF X$<>"" THEN G$=X$ 1210 PRINT "instruction filename (rtn=";H$;:INPUT")";X$:IF X$<>"" THEN H$=X$ 1220 INPUT "switch displays (rtn=no)";I$ 1230 IF I$="" THEN RETURN 1240 IF LD=13 THEN DEF SEG=0:POKE &H410,(PEEK(&H410) AND &HCF) OR &H10:SCREEN 1,0,0,0:SCREEN 0:WIDTH 40:WIDTH 80:LOCATE ,,1,6,7:LD=7 ELSE IF LD=7 THEN DEF SEG=0:POKE &H410,(PEEK(&H410) OR &H30):SCREEN 0:WIDTH 40:WIDTH 80:LOCATE ,,1,12,13:LD=13 1250 RETURN 1260 '=============================load disk file=========================== 1270 OPEN F$ FOR INPUT AS #1 1280 FOR NLINE=0 TO LMX 1290 LINE INPUT #1,A$(NLINE) 1300 IF EOF(1) THEN CLOSE #1: RETURN 1310 NEXT 1320 CLOSE #1: RETURN 1330 '=============================save file on disk========================= 1340 OPEN G$ FOR OUTPUT AS #1 1350 FOR I=0 TO NLINE 1360 PRINT #1,A$(I) 1370 NEXT 1380 CLOSE #1: RETURN 1381 '================================yank=================================== 1382 LOCATE 24,1:INPUT;"# of lines (rtn=1) ";NM:IF NM<1 THEN NM=1 1383 IX=JP+JY-1 1384 FOR I=0 TO NM-1 1385 M$(I)=A$(IX+I) 1386 NEXT 1387 RETURN 1390 '===============================delete================================== 1400 IF NLINE>NM THEN NLINE=NLINE-NM ELSE NLINE=0 1410 FOR I=IX TO NLINE 1411 A$(I)=A$(I+NM) 1412 NEXT 1413 FOR I=NLINE+1 TO NLINE+NM+1 1414 A$(I)="" 1415 NEXT 1416 RETURN 1419 '=================================put=================================== 1420 IX=JP+JY 1430 FOR J=NM-1 TO 0 STEP -1 1440 X$=M$(J):GOSUB 1520 1445 NEXT 1446 RETURN 1450 '============================insertion loop============================= 1460 CLS:J0=JP:J1=JP+JY-1:GOSUB 920:J0=J1+1:J1=JP+21:LOCATE JY+2,1:GOSUB 920 1470 COLOR 11,0: LOCATE JY+1,1,1,LD,0 'display split cursor 1480 LINE INPUT "",X$: X$=STRING$(IP-1," ")+X$: XX=INSTR(X$,CC$) 1490 IF XX<>0 THEN 460 ELSE IF CSRLIN<>JY+2 THEN BEEP: GOTO 1460 1500 IX=JP+JY:GOSUB 1520:JP=JP+1:GOTO 1460 1510 '--------------------------insert x$ at line ix------------------------ 1520 FOR I=IX TO NLINE 1530 SWAP X$,A$(I) 1540 NEXT 1550 NLINE=NLINE+1: IF NLINE>LMX THEN NLINE=LMX: BEEP: RETURN 1560 A$(NLINE)=X$: RETURN 1570 '========================file printing routine========================== 1580 '------------------------set new printer options------------------------ 1590 CLS: GOSUB 1940: LW=80: W$="" 'reset printer and initialize 1600 INPUT "top/bottom margins, in inches (rtn=0)";TBM 1610 INPUT "linespacing (d=double; t=triple; h=1/2; s=1/3; rtn=normal)";D$ 1620 IF D$="" THEN LX=6 ELSE IF D$="d" THEN LX=3 ELSE IF D$="t" THEN LX=2 1630 IF D$="h" THEN LX=12 ELSE IF D$="s" THEN LX=18 1640 LM=TBM*LX: LPRINT CHR$(27);"A";CHR$(72/LX);CHR$(27);"2";'set linespace 1650 INPUT "characters/inch (s=16.5; m=8.25; l=5; rtn=10) ",C$ 1660 IF C$="s" OR C$="m" THEN LPRINT CHR$(15);: LW=132 'set compressed width 1670 IF C$="l" OR C$="m" THEN W$=CHR$(14): LW=LW/2 'set double-width flag 1680 WIDTH "lpt1:",LW 1690 INPUT "intensity (d=double, e=emphasized, b=both, rtn=light) ",I$ 1700 IF I$="d" OR I$="b" THEN LPRINT CHR$(27)+"G";'set doublestrike mode 1710 IF I$="e" OR I$="b" THEN LPRINT CHR$(27)+"E";'set emphasized intensity 1720 LPRINT CHR$(27);"D"; 'lines 100-120 set horiz. tabs (10,8,8,8...) 1730 FOR I=18 TO 74 STEP 8: LPRINT CHR$(I);: NEXT 1740 LPRINT CHR$(0); 1750 INPUT;"from row: ",I0 1760 INPUT;" to: ",I1:IF I1=0 THEN I1=NLINE:PRINT I1 ELSE PRINT 1770 INPUT;"from column: ",J0 1780 INPUT;" to: ",J1:IF J1=0 THEN J1=J0+7:PRINT J1 ELSE PRINT 1790 INPUT "indentation (rtn=0 spaces) ";INDENT 1800 IX=I0:J1=(J1-J0+1)*LCW:J0=J0*LCW+1:IF J1+INDENT>=LW THEN J1=LW-INDENT-1 1810 ' -------------------------------print file------------------------------ 1820 FOR I=1 TO LM 'begin page 1830 LPRINT 1840 NEXT 1850 FOR I=1 TO 11*LX-2*LM 1860 LPRINT SPC(INDENT);W$+MID$(A$(IX),J0,J1) 1870 IF IX<I1 THEN IX=IX+1 ELSE GOSUB 1940: RETURN 1880 NEXT 1890 FOR I=1 TO LM 1900 LPRINT 1910 NEXT 1920 GOTO 1820 1930 ' -----------------------------reset printer---------------------------- 1940 LPRINT CHR$(27);"A";CHR$(12);'set default line-spacing to 12/72=1/6" 1950 LPRINT CHR$(27);"2"; 'invoke default line-spacing 1960 LPRINT CHR$(18); 'compressed width off 1970 LPRINT CHR$(20); 'double-width off (optional) 1980 LPRINT CHR$(27)+"F"; 'emphasized intensity off 1990 LPRINT CHR$(27)+"H"; 'double-strike intensity off 2000 WIDTH "lpt1:",80: RETURN 2010 '=====================set linewidth for justification================== 2020 LOCATE 24,1: INPUT;"line width (rtn=60)";LWIDTH 2030 IF LWIDTH=0 THEN LWIDTH=60 2040 INPUT;" how many lines at once (rtn=1)";JL: IF JL=0 THEN JL=1 2050 RETURN 2060 '---------------------------Justify Function-------------------------- 2070 IF LWIDTH=0 THEN GOSUB 2020 'reset linewidth 2080 J0=JY+JP-1: J1=J0+JL-1: IF J1>NLINE THEN J1=NLINE 2090 FOR IX=J0 TO J1 2100 GOSUB 2140 2110 NEXT 2120 RETURN 2130 '----------------------------justify line------------------------------ 2140 Y$=A$(IX) 2150 '-------------------------remove rightmost spaces---------------------- 2160 YL=LEN(Y$):IF RIGHT$(Y$,1)=" " THEN Y$=LEFT$(Y$,YL-1):GOTO 2160 2170 '----------------------replace indentations with nulls----------------- 2180 IF LEFT$(Y$,1)=CHR$(9) THEN Y$=" "+RIGHT$(Y$,YL-1): YL=YL+7 2190 IF YL=0 OR YL=LWIDTH THEN RETURN 2200 Z$="": M=1 2210 WHILE LEFT$(Y$,1)=" ":Z$=Z$+CHR$(0):Y$=RIGHT$(Y$,YL-M):M=M+1:WEND 2220 Y$=Z$+Y$ 2230 '------------------------optimize content of line---------------------- 2240 IF YL<LWIDTH THEN GOSUB 2420 ELSE GOSUB 2590 2250 '---------------------right justify line if appropriate---------------- 2260 YL=LEN(Y$): NEEDED=LWIDTH-YL 2270 IF INSTR(Y$," ")=0 THEN NEEDED=0 2280 C$=LEFT$(A$(IX+1),1) 2290 IF C$="" OR C$=" " OR C$=CHR$(0) OR C$=CHR$(9) THEN NEEDED=0 2300 Z$="" 2310 FOR I=1 TO NEEDED 2320 M=INSTR(Y$," ") 2330 IF M=0 THEN Y$=Z$+Y$: YL=LEN(Y$): Z$="": GOTO 2320 2340 IF M=1 THEN Z$=Z$+" ": Y$=RIGHT$(Y$,YL-1): YL=YL-1: GOTO 2320 2350 Z$=Z$+LEFT$(Y$,M)+" ": Y$=RIGHT$(Y$,YL-M): YL=YL-M 2360 NEXT 2370 Y$=Z$+Y$: YL=LEN(Y$) 2380 '---------------------replace initial nulls with spaces---------------- 2390 Z$="": M=1 2400 WHILE LEFT$(Y$,1)=CHR$(0):Z$=Z$+" ":Y$=RIGHT$(Y$,YL-M):M=M+1:WEND 2410 A$(IX)=Z$+Y$: RETURN 2420 '---------------------line is too short..can we add some?-------------- 2430 J=IX+1 2440 WHILE NLINE>=J 2450 C$=LEFT$(A$(J),1) 2460 IF C$="" OR C$=" " OR C$=CHR$(9) OR C$=CHR$(0) THEN RETURN 2470 WHILE A$(J)<>"" 2480 ZL=LEN(A$(J)) 2490 M=INSTR(A$(J)," "): IF M=0 THEN ZL=ZL+1: M=ZL 2500 IF YL+M>LWIDTH THEN RETURN 2510 YL=YL+M: Y$=Y$+" ": IF M>1 THEN Y$=Y$+LEFT$(A$(J),M-1) 2520 A$(J)=RIGHT$(A$(J),ZL-M) 2530 WEND 2540 Z$="" 2550 FOR I=NLINE TO J STEP -1: SWAP Z$,A$(I): NEXT 2560 NLINE=NLINE-1 2570 WEND 2580 RETURN 2590 '---------------------line is too long..take something off------------ 2600 Z$=RIGHT$(Y$,YL-LWIDTH): YL=LWIDTH: Y$=LEFT$(Y$,LWIDTH) 2610 C$=RIGHT$(Y$,1): YL=YL-1: Y$=LEFT$(Y$,YL) 2620 IF C$<>" " THEN Z$=C$+Z$: GOTO 2610 2630 FOR I=IX+1 TO NLINE: SWAP Z$,A$(I): NEXT 2640 NLINE=NLINE+1: IF NLINE>LMX THEN NLINE=LMX: BEEP: RETURN 2650 A$(NLINE)=Z$: RETURN 5000 '======================error trapping (line 5000)================== 5010 Q$=" ...File not found... " 5020 IF ERR=53 AND ERL=1270 THEN PRINT Q$: RESUME 370 5030 IF ERR=53 AND ERL=9990 THEN PRINT Q$;: H$="": RESUME 9990 5040 IF ERR=61 AND ERL=1360 THEN PRINT "Disk Full:make room before saving" 5050 IF ERR=25 AND ERL=1940 THEN PRINT "Printer not On-line" 5060 IF ERR=27 THEN PRINT "Out of Paper or Printer Off" 5070 PRINT: PRINT "error #";ERR;" at line ";ERL;"; type CONT to resume..." 5080 STOP: RESUME 460 9610 '===============spread sheet subroutines (line 9610)============== 9620 '---------------------------form column sums------------------------- 9630 IF NROW<2 THEN GOTO 9770 9640 FOR J=0 TO NCOL-1 9650 CSUM(J)=0 9660 FOR I=0 TO NROW-1 9670 CSUM(J)=CSUM(J)+FNV(I+NROW0,J+NCOL0) 9680 NEXT 9690 NEXT 9700 I=NROW0+NROW: TSUM=0 9710 FOR J=NCOL0 TO NCOL0+NCOL-1 9720 X=CSUM(J-NCOL0): GOSUB 9900 9730 TSUM=TSUM+CSUM(J-NCOL0) 9740 NEXT 9750 J=NCOL0+NCOL: X=TSUM: GOSUB 9900 9760 '---------------------------form row sums---------------------------- 9770 IF NCOL<2 THEN RETURN 9780 FOR I=0 TO NROW-1 9790 RSUM(I)=0 9800 FOR J=0 TO NCOL-1 9810 RSUM(I)=RSUM(I)+FNV(I+NROW0,J+NCOL0) 9820 NEXT 9830 NEXT 9840 J=NCOL0+NCOL 9850 FOR I=NROW0 TO NROW0+NROW-1 9860 X=RSUM(I-NROW0): GOSUB 9900 9870 NEXT 9880 RETURN 9890 '-----------------replace row i, column j entry with x--------------- 9900 X$=STR$(X) 9910 '-----------------replace row i, column j entry with x$-------------- 9920 LX=LEN(X$) 9930 IF LX<LCM THEN X$=STRING$(LCM-LX," ")+X$ ELSE X$=LEFT$(X$,LCM) 9940 LA=LEN(A$(I)): LX=LCW*J 9950 IF LX>LA THEN A$(I)=A$(I)+STRING$(LX-LA," ")+X$: RETURN 9960 IF LX>LA-LCM THEN A$(I)=LEFT$(A$(I),LX)+X$: RETURN 9970 A$(I)=LEFT$(A$(I),LX)+X$+RIGHT$(A$(I),LA-LX-LCM): RETURN 9980 '----------------------update computed quantities-------------------- 9990 IF H$="" THEN LOCATE 24,1: INPUT;"instruction filename";H$: IF H$="" THEN 460 ELSE CHAIN MERGE H$,10000,ALL 10000 '----------ROWCOL.BAS - sample row-column sum instructions----------- 10010 ON ERROR GOTO 5000 'this prevents disabling of error trapping 10020 NROW0=FNV(2,6):NCOL0=FNV(3,6):NROW=FNV(4,6):NCOL=FNV(5,6) 'read table 10030 GOSUB 9630 'form sums 10040 I=NROW0+NROW: J=NCOL0-1: X$="Column Totals" : GOSUB 9920 'label row 10050 I=NROW0-2: J=NCOL0+NCOL: X$="Row Totals" : GOSUB 9920 'label col 10060 GOTO 460 'this exits to the View Function